home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / vm / vm-save.el.z / vm-save.el
Encoding:
Text File  |  1998-05-21  |  21.2 KB  |  588 lines
  1. ;;; Saving and piping messages under VM
  2. ;;; Copyright (C) 1989, 1990, 1993, 1994 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (provide 'vm-save)
  19.  
  20. ;; (match-data) returns the match data as MARKERS, often corrupting
  21. ;; it in the process due to buffer narrowing, and the fact that buffers are
  22. ;; indexed from 1 while strings are indexed from 0. :-(
  23. (defun vm-match-data ()
  24.   (let ((index '(9 8 7 6 5 4 3 2 1 0))
  25.         (list))
  26.     (while index
  27.       (setq list (cons (match-beginning (car index))
  28.                (cons (match-end (car index)) list))
  29.         index (cdr index)))
  30.     list ))
  31.  
  32. (defun vm-auto-select-folder (mp auto-folder-alist)
  33.   (condition-case error-data
  34.       (catch 'match
  35.     (let (header alist tuple-list)
  36.       (setq alist auto-folder-alist)
  37.       (while alist
  38.         (setq header (vm-get-header-contents (car mp) (car (car alist))
  39.                          ", "))
  40.         (if (null header)
  41.         ()
  42.           (setq tuple-list (cdr (car alist)))
  43.           (while tuple-list
  44.         (if (let ((case-fold-search vm-auto-folder-case-fold-search))
  45.               (string-match (car (car tuple-list)) header))
  46.             ;; Don't waste time eval'ing an atom.
  47.             (if (atom (cdr (car tuple-list)))
  48.             (throw 'match (cdr (car tuple-list)))
  49.               (let* ((match-data (vm-match-data))
  50.                  ;; allow this buffer to live forever
  51.                  (buf (get-buffer-create " *vm-auto-folder*"))
  52.                  (result))
  53.             ;; Set up a buffer that matches our cached
  54.             ;; match data.
  55.             (save-excursion
  56.               (set-buffer buf)
  57.               (widen)
  58.               (erase-buffer)
  59.               (insert header)
  60.               ;; It appears that get-buffer-create clobbers the
  61.               ;; match-data.
  62.               ;;
  63.               ;; The match data is off by one because we matched
  64.               ;; a string and Emacs indexes strings from 0 and
  65.               ;; buffers from 1.
  66.               ;;
  67.               ;; Also store-match-data only accepts MARKERS!!
  68.               ;; AUGHGHGH!!
  69.               (store-match-data
  70.                (mapcar
  71.                 (function (lambda (n) (and n (vm-marker n))))
  72.                 (mapcar
  73.                  (function (lambda (n) (and n (1+ n))))
  74.                  match-data)))
  75.               (setq result (eval (cdr (car tuple-list))))
  76.               (while (consp result)
  77.                 (setq result (vm-auto-select-folder mp result)))
  78.               (if result
  79.                   (throw 'match result))))))
  80.         (setq tuple-list (cdr tuple-list))))
  81.         (setq alist (cdr alist)))
  82.       nil ))
  83.     (error (error "error processing vm-auto-folder-alist: %s"
  84.           (prin1-to-string error-data)))))
  85.  
  86. (defun vm-auto-archive-messages (&optional arg)
  87.   "Save all unfiled messages that auto-match a folder via
  88. vm-auto-folder-alist to their appropriate folders.  Messages that
  89. are flagged for deletion are not saved.
  90.  
  91. Prefix arg means to ask user for confirmation before saving each message.
  92.  
  93. When invoked on marked messages (via vm-next-command-uses-marks),
  94. only marked messages are checked against vm-auto-folder-alist.
  95.  
  96. The saved messages are flagged as `filed'."
  97.   (interactive "P")
  98.   (vm-select-folder-buffer)
  99.   (vm-check-for-killed-summary)
  100.   (vm-error-if-folder-empty)
  101.   (message "Archiving...")
  102.   (let ((auto-folder)
  103.     (archived 0))
  104.     (unwind-protect
  105.     ;; Need separate (let ...) so vm-message-pointer can
  106.     ;; revert back in time for
  107.     ;; (vm-update-summary-and-mode-line).
  108.     ;; vm-last-save-folder is tucked away here since archives
  109.     ;; shouldn't affect its value.
  110.     (let ((vm-message-pointer
  111.            (if (eq last-command 'vm-next-command-uses-marks)
  112.            (vm-select-marked-or-prefixed-messages 0)
  113.          vm-message-list))
  114.           (done nil)
  115.           stop-point
  116.           (vm-last-save-folder vm-last-save-folder)
  117.           (vm-move-after-deleting nil))
  118.       ;; mark the place where we should stop.  otherwise if any
  119.       ;; messages in this folder are archived to this folder
  120.       ;; we would file messages into this folder forever.
  121.       (setq stop-point (vm-last vm-message-pointer))
  122.       (while (not done)
  123.         (and (not (vm-filed-flag (car vm-message-pointer)))
  124.          ;; don't archive deleted messages
  125.          (not (vm-deleted-flag (car vm-message-pointer)))
  126.          (setq auto-folder (vm-auto-select-folder
  127.                     vm-message-pointer
  128.                     vm-auto-folder-alist))
  129.          (or (null arg)
  130.              (y-or-n-p
  131.               (format "Save message %s in folder %s? "
  132.                   (vm-number-of (car vm-message-pointer))
  133.                   auto-folder)))
  134.          (let ((vm-delete-after-saving vm-delete-after-archiving))
  135.            (vm-save-message auto-folder)
  136.            (vm-increment archived)
  137.            (message "%d archived, still working..." archived)))
  138.         (setq done (eq vm-message-pointer stop-point)
  139.           vm-message-pointer (cdr vm-message-pointer))))
  140.       ;; fix mode line
  141.       (intern (buffer-name) vm-buffers-needing-display-update)
  142.       (vm-update-summary-and-mode-line))
  143.     (if (zerop archived)
  144.     (message "No messages were archived")
  145.       (message "%d message%s archived"
  146.            archived (if (= 1 archived) "" "s")))))
  147.  
  148. (defun vm-save-message (folder &optional count)
  149.   "Save the current message to a mail folder.
  150. If the folder already exists, the message will be appended to it.
  151.  
  152. Prefix arg COUNT means save this message and the next COUNT-1
  153. messages.  A negative COUNT means save this message and the
  154. previous COUNT-1 messages.
  155.  
  156. When invoked on marked messages (via vm-next-command-uses-marks),
  157. all marked messages in the current folder are saved; other messages are
  158. ignored.
  159.  
  160. The saved messages are flagged as `filed'."
  161.   (interactive
  162.    (list
  163.     ;; protect value of last-command
  164.     (let ((last-command last-command)
  165.       (this-command this-command))
  166.       (vm-follow-summary-cursor)
  167.       (let ((default (save-excursion
  168.                (vm-select-folder-buffer)
  169.                (vm-check-for-killed-summary)
  170.                (vm-error-if-folder-empty)
  171.                (or (vm-auto-select-folder vm-message-pointer
  172.                           vm-auto-folder-alist)
  173.                vm-last-save-folder)))
  174.         (dir (or vm-folder-directory default-directory)))
  175.     (cond ((and default
  176.             (let ((default-directory dir))
  177.               (file-directory-p default)))
  178.            (vm-read-file-name "Save in folder: " dir nil nil default))
  179.           (default
  180.            (vm-read-file-name
  181.         (format "Save in folder: (default %s) " default)
  182.         dir default))
  183.           (t
  184.            (vm-read-file-name "Save in folder: " dir nil)))))
  185.     (prefix-numeric-value current-prefix-arg)))
  186.   (let (auto-folder unexpanded-folder)
  187.     (vm-select-folder-buffer)
  188.     (vm-check-for-killed-summary)
  189.     (vm-error-if-folder-empty)
  190.     (setq unexpanded-folder folder
  191.       auto-folder (vm-auto-select-folder vm-message-pointer
  192.                          vm-auto-folder-alist))
  193.     (vm-display nil nil '(vm-save-message) '(vm-save-message))
  194.     (or count (setq count 1))
  195.     ;; Expand the filename, forcing relative paths to resolve
  196.     ;; into the folder directory.
  197.     (let ((default-directory
  198.         (expand-file-name (or vm-folder-directory default-directory))))
  199.       (setq folder (expand-file-name folder)))
  200.     ;; Confirm new folders, if the user requested this.
  201.     (if (and vm-confirm-new-folders (interactive-p)
  202.          (not (file-exists-p folder))
  203.          (or (not vm-visit-when-saving) (not (vm-get-file-buffer folder)))
  204.          (not (y-or-n-p (format "%s does not exist, save there anyway? "
  205.                     folder))))
  206.     (error "Save aborted"))
  207.     ;; Check and see if we are currently visiting the folder
  208.     ;; that the user wants to save to.
  209.     (if (and (not vm-visit-when-saving) (vm-get-file-buffer folder))
  210.     (error "Folder %s is being visited, cannot save." folder))
  211.     (let ((mlist (vm-select-marked-or-prefixed-messages count))
  212.       (m nil) (count 0) folder-buffer target-type)
  213.       (cond ((and mlist (eq vm-visit-when-saving t))
  214.          (setq folder-buffer (or (vm-get-file-buffer folder)
  215.                      ;; avoid letter bombs
  216.                      (let ((inhibit-local-variables t)
  217.                        (enable-local-variables nil))
  218.                        (find-file-noselect folder)))))
  219.         ((and mlist vm-visit-when-saving)
  220.          (setq folder-buffer (vm-get-file-buffer folder))))
  221.       (if (and mlist vm-check-folder-types)
  222.       (progn
  223.         (setq target-type (or (vm-get-folder-type folder)
  224.                   vm-default-folder-type
  225.                   (and mlist
  226.                        (vm-message-type-of (car mlist)))))
  227.         (if (eq target-type 'unknown)
  228.         (error "Folder %s's type is unrecognized" folder))))
  229.       ;; if target folder is empty or nonexistent we need to
  230.       ;; write out the folder header first.
  231.       (if mlist
  232.       (let ((attrs (file-attributes folder)))
  233.         (if (or (null attrs) (= 0 (nth 7 attrs)))
  234.         (if (null folder-buffer)
  235.             (vm-write-string folder (vm-folder-header target-type))
  236.           (vm-write-string folder-buffer
  237.                    (vm-folder-header target-type))))))
  238.       (save-excursion
  239.     (while mlist
  240.       (setq m (vm-real-message-of (car mlist)))
  241.       (set-buffer (vm-buffer-of m))
  242.       (vm-save-restriction
  243.        (widen)
  244.        ;; have to stuff the attributes in all cases because
  245.        ;; the deleted attribute may have been stuffed
  246.        ;; previously and we don't want to save that attribute.
  247.        ;; also we don't want to save out the cached summary entry.
  248.        (vm-stuff-attributes m t)
  249.        (if (null folder-buffer)
  250.            (if (or (null vm-check-folder-types)
  251.                (eq target-type (vm-message-type-of m)))
  252.            (write-region (vm-start-of m)
  253.                  (vm-end-of m)
  254.                  folder t 'quiet)
  255.          (if (null vm-convert-folder-types)
  256.              (if (not (vm-virtual-message-p (car mlist)))
  257.              (error "Folder type mismatch: %s, %s"
  258.                 (vm-message-type-of m) target-type)
  259.                (error "Message %s type mismatches folder %s"
  260.                   (vm-number-of (car mlist))
  261.                   folder
  262.                   (vm-message-type-of m)
  263.                   target-type))
  264.            (vm-write-string
  265.             folder
  266.             (vm-leading-message-separator target-type m t))
  267.            (if (eq target-type 'From_-with-Content-Length)
  268.                (vm-write-string
  269.             folder
  270.             (concat vm-content-length-header " "
  271.                 (vm-su-byte-count m) "\n")))
  272.            (write-region (vm-headers-of m)
  273.                  (vm-text-end-of m)
  274.                  folder t 'quiet)
  275.            (vm-write-string
  276.             folder
  277.             (vm-trailing-message-separator target-type))))
  278.          (save-excursion
  279.            (set-buffer folder-buffer)
  280.            ;; if the buffer is a live VM folder
  281.            ;; honor vm-folder-read-only.
  282.            (if vm-folder-read-only
  283.            (signal 'folder-read-only (list (current-buffer))))
  284.            (let ((buffer-read-only nil))
  285.          (vm-save-restriction
  286.           (widen)
  287.           (save-excursion
  288.             (goto-char (point-max))
  289.             (if (or (null vm-check-folder-types)
  290.                 (eq target-type (vm-message-type-of m)))
  291.             (insert-buffer-substring
  292.              (vm-buffer-of m)
  293.              (vm-start-of m) (vm-end-of m))
  294.               (if (null vm-convert-folder-types)
  295.               (if (not (vm-virtual-message-p (car mlist)))
  296.                   (error "Folder type mismatch: %s, %s"
  297.                      (vm-message-type-of m) target-type)
  298.                 (error "Message %s type mismatches folder %s"
  299.                    (vm-number-of (car mlist))
  300.                    folder
  301.                    (vm-message-type-of m)
  302.                    target-type))
  303.             (vm-write-string
  304.              (current-buffer)
  305.              (vm-leading-message-separator target-type m t))
  306.             (if (eq target-type 'From_-with-Content-Length)
  307.                 (vm-write-string
  308.                  (current-buffer)
  309.                  (concat vm-content-length-header " "
  310.                      (vm-su-byte-count m) "\n")))
  311.             (insert-buffer-substring (vm-buffer-of m)
  312.                          (vm-headers-of m)
  313.                          (vm-text-end-of m))
  314.             (vm-write-string
  315.              (current-buffer)
  316.              (vm-trailing-message-separator target-type)))))
  317.           ;; vars should exist and be local
  318.           ;; but they may have strange values,
  319.           ;; so check the major-mode.
  320.           (cond ((eq major-mode 'vm-mode)
  321.              (vm-increment vm-messages-not-on-disk)
  322.              (vm-clear-modification-flag-undos)))))))
  323.        (if (null (vm-filed-flag m))
  324.            (vm-set-filed-flag m t))
  325.        (vm-increment count)
  326.        (vm-update-summary-and-mode-line)
  327.        (setq mlist (cdr mlist)))))
  328.       (if m
  329.       (if folder-buffer
  330.           (progn
  331.         (save-excursion
  332.           (set-buffer folder-buffer)
  333.           (if (eq major-mode 'vm-mode)
  334.               (progn
  335.             (vm-check-for-killed-summary)
  336.             (vm-assimilate-new-messages)
  337.             (if (null vm-message-pointer)
  338.                 (progn (setq vm-message-pointer vm-message-list
  339.                      vm-need-summary-pointer-update t)
  340.                    (intern (buffer-name)
  341.                        vm-buffers-needing-display-update)
  342.                    (vm-preview-current-message))
  343.               (vm-update-summary-and-mode-line)))))
  344.         (if (interactive-p)
  345.             (message "%d message%s saved to buffer %s"
  346.                  count
  347.                  (if (/= 1 count) "s" "")
  348.                  (buffer-name folder-buffer))))
  349.         (if (interactive-p)
  350.         (message "%d message%s saved to %s"
  351.              count (if (/= 1 count) "s" "") folder)))))
  352.     (if (or (null vm-last-save-folder)
  353.         (not (equal unexpanded-folder auto-folder)))
  354.     (setq vm-last-save-folder unexpanded-folder))
  355.     (if vm-delete-after-saving
  356.     (vm-delete-message count))))
  357.  
  358. (defun vm-save-message-sans-headers (file &optional count)
  359.   "Save the current message to a file, without its header section.
  360. If the file already exists, the message will be appended to it.
  361. Prefix arg COUNT means save the next COUNT messages.  A negative COUNT means
  362. save the previous COUNT.
  363.  
  364. When invoked on marked messages (via vm-next-command-uses-marks),
  365. all marked messages in the current folder are saved; other messages are
  366. ignored.
  367.  
  368. The saved messages are flagged as `written'.
  369.  
  370. This command should NOT be used to save message to mail folders; use
  371. vm-save-message instead (normally bound to `s')."
  372.   (interactive
  373.    ;; protect value of last-command
  374.    (let ((last-command last-command)
  375.      (this-command this-command))
  376.      (vm-follow-summary-cursor)
  377.      (vm-select-folder-buffer)
  378.      (list
  379.       (vm-read-file-name
  380.        (if vm-last-written-file
  381.        (format "Write text to file: (default %s) "
  382.            vm-last-written-file)
  383.      "Write text to file: ")
  384.        nil vm-last-written-file nil)
  385.       (prefix-numeric-value current-prefix-arg))))
  386.   (vm-select-folder-buffer)
  387.   (vm-check-for-killed-summary)
  388.   (vm-error-if-folder-empty)
  389.   (vm-display nil nil '(vm-save-message-sans-headers)
  390.           '(vm-save-message-sans-headers))
  391.   (or count (setq count 1))
  392.   (setq file (expand-file-name file))
  393.   ;; Check and see if we are currently visiting the file
  394.   ;; that the user wants to save to.
  395.   (if (and (not vm-visit-when-saving) (vm-get-file-buffer file))
  396.       (error "File %s is being visited, cannot save." file))
  397.   (let ((mlist (vm-select-marked-or-prefixed-messages count))
  398.     (m nil) file-buffer)
  399.     (cond ((and mlist (eq vm-visit-when-saving t))
  400.        (setq file-buffer (or (vm-get-file-buffer file)
  401.                  (find-file-noselect file))))
  402.       ((and mlist vm-visit-when-saving)
  403.        (setq file-buffer (vm-get-file-buffer file))))
  404.     (save-excursion
  405.       (while mlist
  406.     (setq m (vm-real-message-of (car mlist)))
  407.     (set-buffer (vm-buffer-of m))
  408.     (vm-save-restriction
  409.      (widen)
  410.      (if (null file-buffer)
  411.          (write-region (vm-text-of m)
  412.                (vm-text-end-of m)
  413.                file t 'quiet)
  414.        (let ((start (vm-text-of m))
  415.          (end (vm-text-end-of m)))
  416.          (save-excursion
  417.            (set-buffer file-buffer)
  418.            (save-excursion
  419.          (let (buffer-read-only)
  420.            (vm-save-restriction
  421.             (widen)
  422.             (save-excursion
  423.               (goto-char (point-max))
  424.               (insert-buffer-substring
  425.                (vm-buffer-of m)
  426.                start end))))))))
  427.     (if (null (vm-written-flag m))
  428.         (vm-set-written-flag m t))
  429.     (vm-update-summary-and-mode-line)
  430.     (setq mlist (cdr mlist)))))
  431.     (if m
  432.     (if file-buffer
  433.         (message "Message%s written to buffer %s" (if (/= 1 count) "s" "")
  434.              (buffer-name file-buffer))
  435.       (message "Message%s written to %s" (if (/= 1 count) "s" "") file)))
  436.     (setq vm-last-written-file file)))
  437.  
  438. (defun vm-pipe-message-to-command (command prefix-arg)
  439.   "Runs a shell command with some or all of the contents of the
  440. current message as input.
  441. By default, the entire message is used.
  442. With one \\[universal-argument] the text portion of the message is used.
  443. With two \\[universal-argument]'s the header portion of the message is used.
  444. With three \\[universal-argument]'s the visible header portion of the message
  445.   plus the text portion is used.
  446.  
  447. When invoked on marked messages (via vm-next-command-uses-marks),
  448. each marked message is successively piped to the shell command,
  449. one message per command invocation.
  450.  
  451. Output, if any, is displayed.  The message is not altered."
  452.   (interactive
  453.    ;; protect value of last-command
  454.    (let ((last-command last-command)
  455.      (this-command this-command))
  456.      (vm-follow-summary-cursor)
  457.      (vm-select-folder-buffer)
  458.      (list (read-string "Pipe to command: " vm-last-pipe-command)
  459.        current-prefix-arg)))
  460.   (vm-select-folder-buffer)
  461.   (vm-check-for-killed-summary)
  462.   (vm-error-if-folder-empty)
  463.   (setq vm-last-pipe-command command)
  464.   (let ((buffer (get-buffer-create "*Shell Command Output*"))
  465.     m
  466.     (pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))
  467.     ;; prefix arg doesn't have "normal" meaning here, so only call
  468.     ;; vm-select-marked-or-prefixed-messages if we're using marks.
  469.     (mlist (if (eq last-command 'vm-next-command-uses-marks)
  470.            (vm-select-marked-or-prefixed-messages 0)
  471.          (list (car vm-message-pointer)))))
  472.     (set-buffer buffer)
  473.     (erase-buffer)
  474.     (while mlist
  475.       (setq m (vm-real-message-of (car mlist)))
  476.       (set-buffer (vm-buffer-of m))
  477.       (save-restriction
  478.     (widen)
  479.     (goto-char (vm-headers-of m))
  480.     (cond ((equal prefix-arg nil)
  481.            (narrow-to-region (point) (vm-text-end-of m)))
  482.           ((equal prefix-arg '(4))
  483.            (narrow-to-region (vm-text-of m)
  484.                  (vm-text-end-of m)))
  485.           ((equal prefix-arg '(16))
  486.            (narrow-to-region (point) (vm-text-of m)))
  487.           ((equal prefix-arg '(64))
  488.            (narrow-to-region (vm-vheaders-of m) (vm-text-end-of m)))
  489.           (t (narrow-to-region (point) (vm-text-end-of m))))
  490.     (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))))
  491.       (call-process-region (point-min) (point-max)
  492.                    (or shell-file-name "sh")
  493.                    nil buffer nil shell-command-switch command)))
  494.       (setq mlist (cdr mlist)))
  495.      (set-buffer buffer)
  496.      (if (not (zerop (buffer-size)))
  497.      (vm-display buffer t '(vm-pipe-message-to-command)
  498.              '(vm-pipe-message-to-command))
  499.        (vm-display nil nil '(vm-pipe-message-to-command)
  500.            '(vm-pipe-message-to-command)))))
  501.  
  502. (defun vm-print-message (&optional count)
  503.   "Print the current message
  504. Prefix arg N means print the current message and the next N - 1 messages.
  505. Prefix arg -N means print the current message and the previous N - 1 messages.
  506.  
  507. The variable `vm-print-command' controls what command is run to
  508. print the message, and `vm-print-command-switches' is a list of switches
  509. to pass to the command.
  510.  
  511. When invoked on marked messages (via vm-next-command-uses-marks),
  512. each marked message is printed, one message per vm-print-command invocation.
  513.  
  514. Output, if any, is displayed.  The message is not altered."
  515.   (interactive "p")
  516.   (vm-follow-summary-cursor)
  517.   (vm-select-folder-buffer)
  518.   (vm-check-for-killed-summary)
  519.   (vm-error-if-folder-empty)
  520.   (or count (setq count 1))
  521.   (let* ((buffer (get-buffer-create "*Shell Command Output*"))
  522.      (need-tempfile (string-match ".*-.*-\\(win95\\|nt\\)"
  523.                       system-configuration))
  524.      (tempfile (if need-tempfile (vm-make-tempfile-name)))
  525.      (command (mapconcat (function identity)
  526.                  (nconc (list vm-print-command)
  527.                     (copy-sequence vm-print-command-switches)
  528.                     (if need-tempfile
  529.                     (list tempfile)))
  530.                  " "))
  531.      (m nil)
  532.      (pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))
  533.      (mlist (vm-select-marked-or-prefixed-messages count)))
  534.     (set-buffer buffer)
  535.     (erase-buffer)
  536.     (while mlist
  537.       (setq m (vm-real-message-of (car mlist)))
  538.       (set-buffer (vm-buffer-of m))
  539.       (if (and vm-display-using-mime (vectorp (vm-mm-layout m)))
  540.       (let ((work-buffer nil))
  541.         (unwind-protect
  542.         (progn
  543.           (setq work-buffer (generate-new-buffer "*vm-work*"))
  544.           (set-buffer work-buffer)
  545.           (vm-insert-region-from-buffer
  546.            (vm-buffer-of m) (vm-vheaders-of m) (vm-text-of m))
  547.           (vm-decode-mime-encoded-words)
  548.           (goto-char (point-max))
  549.           (let ((vm-auto-displayed-mime-content-types
  550.              '("text" "multipart"))
  551.             (vm-mime-internal-content-types
  552.              '("text" "multipart"))
  553.             (vm-mime-external-content-types-alist nil))
  554.             (vm-decode-mime-layout (vm-mm-layout m)))
  555.           (let ((pop-up-windows (and pop-up-windows
  556.                          (eq vm-mutable-windows t))))
  557.             (if need-tempfile
  558.             (write-region (point-min) (point-max)
  559.                       tempfile nil 0))
  560.             (call-process-region (point-min) (point-max)
  561.                      (or shell-file-name "sh")
  562.                      nil buffer nil
  563.                      shell-command-switch command)
  564.             (if need-tempfile
  565.             (vm-error-free-call 'delete-file tempfile))))
  566.           (and work-buffer (kill-buffer work-buffer))))
  567.     (save-restriction
  568.       (widen)
  569.       (narrow-to-region (vm-vheaders-of m) (vm-text-end-of m))
  570.       (let ((pop-up-windows (and pop-up-windows
  571.                      (eq vm-mutable-windows t))))
  572.         (if need-tempfile
  573.         (write-region (point-min) (point-max)
  574.                   tempfile nil 0))
  575.         (call-process-region (point-min) (point-max)
  576.                  (or shell-file-name "sh")
  577.                  nil buffer nil
  578.                  shell-command-switch command)
  579.         (if need-tempfile
  580.         (vm-error-free-call 'delete-file tempfile)))))
  581.       (setq mlist (cdr mlist)))
  582.     (set-buffer buffer)
  583.     (if (not (zerop (buffer-size)))
  584.     (vm-display buffer t '(vm-pipe-message-to-command)
  585.             '(vm-pipe-message-to-command))
  586.       (vm-display nil nil '(vm-pipe-message-to-command)
  587.           '(vm-pipe-message-to-command)))))
  588.